home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
CON-03A.ZIP
/
COMMS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-04-17
|
4KB
|
210 lines
unit comms;
interface
var
comport,modemspeed : integer;
secret, auto_det : boolean;
procedure sendln(stri : string);
procedure sendch(cha : char);
function getch : char;
procedure init_comms;
function carrier : boolean;
procedure sc(cha : char);
procedure send(stri : string);
function num(numb : longint) : string;
function unnum(string_num : string) : integer;
function wfk : char;
function getstring : string;
procedure clearscreen;
procedure modem_cmd(stri : string);
procedure xy(x,y : integer);
implementation
uses crt, ansi_drv;
function char_avail : boolean;
var
status : byte;
begin
asm
mov ah,03h
mov dx,comport
int 14h
mov status, ah
end;
char_avail:=(status and 1) = 1;
end;
procedure sendch(cha : char);
var status : byte;
tosend : byte;
begin
status:=128;
tosend:=ord(cha);
repeat
asm
mov ah,01
mov dx,comport
mov al,tosend
int 14h
mov status,ah
end
until (status and 128) = 0;
end;
function getch : char;
var status,cha : byte;
begin
status:=128;
if char_avail then begin
asm
mov ah,02
mov dx,comport
int 14h
mov cha,al
mov status,ah
end;
end;
if (status and 128) = 128 then getch:=chr(255) else getch:=chr(cha);
end;
procedure init_comms;
var speed : byte;
begin
{ writeln('Initialising communications port!');
case modemspeed of
19200 : speed:=8;
9600 : speed:=7;
4800 : speed:=6;
2400 : speed:=5;
1200 : speed:=4;
end;
asm
mov ah,04
mov al,00
mov bx,00
mov ch,03
mov cl,speed
mov dx,comport
int 14h
end;
sound(1000);
delay(50);
sound(700);
delay(50);
nosound; }
end;
function carrier : boolean;
var status : byte;
begin
asm
mov ah,03
mov dx,comport
int $14
mov status,al
end;
carrier := status and 32 = 32;
end;
procedure modem_cmd(stri : string);
var aa : integer;
begin
if not carrier then begin
sound(1500);
delay(20);
nosound;
{ sendch(#13);
for aa:=1 to length(stri) do sendch(stri[aa]);
sendch(#13); }
end;
end;
procedure sc(cha : char);
begin
if carrier and not secret then sendch(cha);
if secret and carrier then sendch('■');
ansi_write(cha);
end;
procedure send(stri : string);
var aa : integer;
begin
for aa:=1 to length(stri) do sc(stri[aa]);
end;
procedure sendln(stri : string);
var aa : integer;
begin
for aa:=1 to length(stri) do sc(stri[aa]);
sc(chr(13));
sc(chr(10));
end;
function num(numb : longint) : string;
var s : string;
begin
str(numb, s);
num:=s;
end;
function unnum(string_num : string) : integer;
var num,foo : integer;
begin
val(string_num,num,foo);
unnum:=num;
end;
function wfk : char;
var ch : char;
begin
ch:=#255;
repeat
if keypressed then ch:=readkey else
if carrier then ch:=getch;
until ch<>chr(255);
sc(ch);
wfk:=ch;
end;
function getstring : string;
var count : integer;
ch : char;
begin
count:=0;
repeat
ch:=wfk;
if (ch<>#13) and (ch<>#8) then begin
inc(count);
getstring[count]:=ch;
end else if ch=#8 then dec(count);
until ch=#13;
getstring[0]:=chr(count);
end;
procedure xy(x,y : integer);
begin
send(#27+'['+chr(x+ord('0'))+';'+chr(y+ord('0'))+'F');
end;
procedure clearscreen;
begin
send(#27+'[2J');
clrscr;
end;
end. {unit ends}